Attribute VB_Name = "模块1"
Option Explicit
    Dim bb As Workbook
    Dim aa As Worksheet
    Dim rwh As String
    Dim jsh As String
Sub JPrint()
   Dim scx, wlbm, bzr, bzsj, sl, pznr, EOL, smm As String
   Dim l As Integer                                  '配置内容长度
   Set bb = ActiveWorkbook
   Set aa = ActiveSheet
   'On Error GoTo E
   On Error Resume Next
If ActiveSheet.Range("D2").Value <> "产 品 配 置 指 导 书" Then
  MsgBox ("该文件不是挂单文件，请查询配置！")
  Exit Sub
  End If
   scx = aa.Range("D4").Text '生产线
  
   wlbm = aa.Range("D5").Text '物料编码
   jsh = aa.Range("D6").Text  '计生号
   rwh = aa.Range("D7").Text  '任务号
   pznr = aa.Range("D8").Text  '车型配置内容(计划描述)
   
   
   bzr = aa.Range("G4").Text   '编制人
   bzsj = aa.Range("G5").Text  '编制时间
   sl = aa.Range("G6").Text    '数量
    EOL = aa.Range("G7").Text    'EOL
    smm = aa.Range("A10").Text    '挂单说明
   '有供方代码时
If ActiveSheet.Range("G11").Value = "GFDM" Then
  bzr = aa.Range("H4").Text   '编制人
   bzsj = aa.Range("H5").Text  '编制时间
   sl = aa.Range("H6").Text    '数量
   
   EOL = aa.Range("H7").Text    'EOL
     
      
End If
   
   l = Len(pznr)               '计划描述长度
   'MsgBox (l)

 Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
    Workbooks("PERSONAL.XLSB").Sheets("Sheet1").Visible = True
    Windows("PERSONAL.XLSB").Activate
    Cells.Select
    Selection.Copy
    bb.Activate
    bb.Sheets("Sheet2").Select
   ' Cells.Select
    'Selection.NumberFormatLocal = "@"
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    
    
    'Workbooks("PERSONAL.XLSB").Sheets("Sheet1").Copy
    Windows("PERSONAL.XLSB").Activate
    ActiveWindow.Visible = False
   ' MsgBox ("程序执行出错，请检查操作！")
    'Workbooks("PERSONAL.XLSB").Visible = False
    Rows("3:3").RowHeight = 3
    Rows("2:2").RowHeight = 12
    bb.Worksheets("Sheet2").Range("C4").Value = scx
    bb.Worksheets("Sheet2").Range("C5").Value = wlbm
    bb.Worksheets("Sheet2").Range("C6").Value = jsh
    bb.Worksheets("Sheet2").Range("C7").Value = rwh
    bb.Worksheets("Sheet2").Range("C8").Value = pznr
    bb.Worksheets("Sheet2").Range("J4").Value = bzr
    bb.Worksheets("Sheet2").Range("J5").Value = bzsj
    bb.Worksheets("Sheet2").Range("J6").Value = sl
    bb.Worksheets("Sheet2").Range("J7").Value = EOL
    bb.Worksheets("Sheet2").Range("A10").Value = smm
    Rows("8:8").Select
    Selection.NumberFormatLocal = "0.00_ "
    Selection.RowHeight = 53.5
    If l > 300 Then Selection.RowHeight = 85
    Call ReadTH
    Call SetFont
    '增加大线挂单判断  ——10.05.19
    Call SetPage
   ' If Left(Trim(scx), 2) = "DX" Then
   ' Call SetLastline
   ' End If
    Application.ScreenUpdating = True             '取消屏幕冻结

    'bb.Worksheets("Sheet2").PrintOut                   '直接打印新表单
    'Application.Dialogs(xlDialogPrint).Show                   '调用打印设置窗口，打印表单
   ' Application.Dialogs(xlDialogPrintPreview).Show              '调用打印预览窗口
'E:
   'If Err = 1004 Then
   'MsgBox ("程序执行出错，请检查操作！")
   'Exit Sub
   'End If
  Selection.CurrentRegion.Select
  
  
  '划线
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    '绘制中线为双线-start
    Range("G11", Range("G11").End(xlDown).Address).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    '绘制中线为双线-end
    '页面设置-start
    With ActiveSheet.PageSetup
    .PrintTitleRows = ""                                '顶端标题行
    .PrintTitleColumns = ""                             '左边标题行
       .LeftHeader = ""                                 '自定义页眉：左
    .CenterHeader = ""                                  '自定义页眉：中国
    .RightHeader = ""                                   '自定义页眉：右
    .LeftFooter = ""                                    '自定义页脚：左
    .CenterFooter = ""                                  '自定义页脚：中
    .RightFooter = ""                                   '自定义页脚：右
    .LeftMargin = Application.InchesToPoints(0)      '页边距：左
    .RightMargin = Application.InchesToPoints(0)     '页边距右
    .TopMargin = Application.InchesToPoints(0.31496062992126)          '页边距上
    .BottomMargin = Application.InchesToPoints(0.511811023622047)       '页边距下
    .HeaderMargin = Application.InchesToPoints(0)     '页边距 页眉
    .FooterMargin = Application.InchesToPoints(0.551181102362205)     '页边距 页脚
    .PrintHeadings = False                              '工作表打印 行号列标
    .PrintGridlines = True                             '工作表打印 网格线
    .PrintComments = xlPrintNoComments                  '工作表打印批注
    .PrintQuality = 180                                 '打印质量
    .CenterHorizontally = True                       '页面居中方式 水平
    .CenterVertically = False                           '页面居中方式 垂直
    .Orientation = xlPortrait                           '页面方向 纵向 xlPortrait  T 横向(L) xlLandscape
    .Draft = False                                      '工作表打印  按草稿方式
    .PaperSize = xlPaper10x14                            '纸张10*14
    .FirstPageNumber = xlAutomatic                      '页面起始页码 自动
    .Order = xlDownThenOver                             '工作表打印顺序 xlOverThenDown
    .BlackAndWhite = False                              '单色打印
    .Zoom = 100                                         '页面缩放  100%
    .Zoom = True                                       '缩放比例 未选中 鑻ラ€夋嫨璋冩暣椤甸潰鍒欐椤瑰繀涓篎alse锛屼笖涓庝笅闈袱椤逛竴璧峰嚭鐜般€?
    .PrintErrors = xlPrintErrorsDisplayed               '错误单元格显示为 N/A
    End With
     '页面设置-end
 
    

End Sub
Sub ReadTH()
'Dim MyFont As StdFont.
Dim nextRow1_1 As Integer
Dim nextRow2_1 As Integer
Dim nextRow1_2 As Integer
Dim nextRow2_2 As Integer
Dim a As String
Dim n As Integer
Dim m As Integer
nextRow1_1 = 0
nextRow1_2 = 0
nextRow2_1 = 0
nextRow2_2 = 0
a = "a"
n = 1
m = 1

    If bb.Worksheets("sheet1").Range("B12").Value = "" Then
    bb.Worksheets("sheet2").Range("B12").Value = bb.Worksheets("sheet1").Range("C12").Value
    Call SetFirstline
   ' bb.Worksheets("sheet2").Range("B11").Font.Name = "宋体"
   ' bb.Worksheets("sheet2").Range("B11").Font.Size = 10
        Do While a <> ""
            Do While n < 7
                 Select Case n
         Case 1 To 4
                bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2).Value = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2).Text
                bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2).Value = bb.Worksheets("sheet1").Range("B13").Offset(nextRow2_1, nextRow2_2).Text
         Case 6
        Dim aa, ab As String
        aa = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2).Text
        ab = bb.Worksheets("sheet1").Range("B13").Offset(nextRow2_1, nextRow2_2).Text
        If aa <> "" Then
             bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2 - 4).Value = bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2 - 4).Value + Chr(10) + "*" + aa + "*"
         End If
          If ab <> "" Then
             bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2 - 4).Value = bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2 - 4).Value + Chr(10) + "*" + ab + "*"
         End If
                    
          End Select
                n = n + 1
                nextRow1_2 = nextRow1_2 + 1
                nextRow2_2 = nextRow2_2 + 1
               
            Loop
            nextRow1_1 = nextRow1_1 + 1
            nextRow2_1 = nextRow2_1 + 2
            nextRow1_2 = 0
            nextRow2_2 = 0
            n = 1
            a = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2 + 1).Value
        Loop
    Else
        Do While a <> ""
            Do While n < 7
         Select Case n
         Case 1 To 4
                bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2).Value = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2).Text
                bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2).Value = bb.Worksheets("sheet1").Range("B13").Offset(nextRow2_1, nextRow2_2).Text
                
         Case 6
         Dim aa1, ab1 As String
         aa1 = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2).Text
         ab1 = bb.Worksheets("sheet1").Range("B13").Offset(nextRow2_1, nextRow2_2).Text
         If aa1 <> "" Then
             bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2 - 4).Value = bb.Worksheets("sheet2").Range("A12").Offset(nextRow1_1, nextRow1_2 - 4).Value + Chr(10) + "*" + aa1 + "*"
         End If
          If ab1 <> "" Then
             bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2 - 4).Value = bb.Worksheets("sheet2").Range("G12").Offset(nextRow1_1, nextRow1_2 - 4).Value + Chr(10) + "*" + ab1 + "*"
         End If
                
                
          End Select
                
                
                
                n = n + 1
                nextRow1_2 = nextRow1_2 + 1
                nextRow2_2 = nextRow2_2 + 1
      
            Loop
            nextRow1_1 = nextRow1_1 + 1
            nextRow2_1 = nextRow2_1 + 2
            nextRow1_2 = 0
            nextRow2_2 = 0
            n = 1
            a = bb.Worksheets("sheet1").Range("B12").Offset(nextRow2_1, nextRow2_2 + 1).Value
        Loop
    End If
    
End Sub
Sub SetFont()
    Dim i, j As Integer                                   'i为列数，j为行数
    Dim s As String
    j = 11
    s = "a"
    Do While s <> ""
    j = j + 1
    s = bb.Worksheets("sheet2").Cells(j, 1).Text
    Loop
         bb.Worksheets("sheet2").Range("A11:J" & j).Font.Name = "宋体"
         bb.Worksheets("sheet2").Range("A11:J" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("B11:B" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("C11:C" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("D11:D" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("G11:G" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("H11:H" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("I11:I" & j).Font.Size = 10
         bb.Worksheets("sheet2").Range("J11:J" & j).Font.Size = 10
If bb.Worksheets("sheet1").Range("B11").Value = "" Then Range("B11:L11").Font.Size = 11
End Sub

Sub SetPage()

    With bb.Worksheets("Sheet2").PageSetup
        .LeftMargin = Application.InchesToPoints(0.590551181102362)
        .RightMargin = Application.InchesToPoints(0.748031496062992)
        .TopMargin = Application.InchesToPoints(0.78740157480315)
        .BottomMargin = Application.InchesToPoints(0.47244094488189)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.275590551181102)
    .PrintTitleRows = bb.Worksheets("Sheet2").Rows(10).Address
    .PaperSize = 45
    '.PaperSize = xlPaperA3
    .CenterHorizontally = True
    .DifferentFirstPageHeaderFooter = True
    .CenterHeader = "任务号：" + rwh + Chr(10) + "计生号：" + jsh + "&F 装配特殊挂单"
    .CenterFooter = "第 &P 页，共 &N 页"
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = "第 &P 页，共 &N 页"
    .FirstPage.RightFooter.Text = ""
End With

End Sub


Sub SetFirstline()

'  设置首行特殊配置格式
    Range("B12:L12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
        .Name = "宋体"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Rows("12:12").RowHeight = 36
End Sub
Sub SetLastline()
 
'设置尾行显示车型及配置内容
 Dim x As String
 Dim p As Integer
 x = "a"
 p = 11
 Do While x <> ""
 p = p + 1
 x = bb.Worksheets("Sheet2").Cells(p, 2).Text
 Loop
 Rows("8:8").Select
 Selection.Copy
 Rows(p).Select
 ActiveSheet.Paste
 Selection.RowHeight = 53.5
End Sub


Function LastColumn(lie)
Dim rng As Range
Set rng = Sheet1.Range(lie + "11").End(xlToLeft)
LastColumn = rng.Address(0, 0)
End Function